home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATHLIB2 / HYPER387.PAS next >
Pascal/Delphi Source File  |  1995-10-14  |  8KB  |  186 lines
  1. Unit HYPER387;
  2.  
  3. (* Bibliotheque mathematique des fonctions hyperboliques *)
  4. (* JD GAYRARD oct 95 *)
  5. (* utilisables uniquement avec un 86387, 86486 et pentium,
  6. pour type single, double et extended, sans controle de domaine de
  7. definition (de la fonction) ou d'utilisation (limitation du FPU).
  8. le prefixe f est pour eviter la redefinition *)
  9.  
  10. {$G+}
  11. {$N+}
  12. {$E-}
  13.  
  14. interface
  15.  
  16. const author  = 'GAYRARD J-D';
  17.       version = 'ver 1.2 - 10/95';
  18.  
  19. type float = double; { a modifier suivant l'utilisation }
  20.  
  21. (* fonctions trigonometriques directes *)
  22. function fch(x : float): float;
  23. function fsh(x : float): float;
  24. function fth(x : float): float;
  25.  
  26. (* fonctions trigonometriques inverses *)
  27. function farg_ch(x : float): float;
  28. function farg_sh(x : float): float;
  29. function farg_th(x : float): float;
  30.  
  31. implementation
  32.  
  33. (* fonctions trigonometriques directes *)
  34.  
  35. function fch(x : float): float; assembler;
  36. (* retourne le cosinus hyperbolique de l'argument *)
  37. { ch(x) = [exp(x) + exp(-x)] / 2
  38. methode : z = exp(x), ch(x) = 1/2 (z + 1/z)
  39.           z = 2^y, y = x.log2(e),
  40.           z = 2^f.2^i, f = frac(y), i = int(y)
  41. { 2^f is computed with F2XM1, 2^i with FSCALE }
  42. const round_down : word = $177F;
  43.       one_half : float = 0.5;
  44. var   control_ww : word;
  45. asm                   { ST(0)     ST(1)     ST(2) }
  46.    FLD X              {  x         -         -    }
  47.    FLDL2E             { log2(e)    x         -    }
  48.    FMULP ST(1), ST    { x.log2(e)  -         -    }
  49.    FSTCW control_ww
  50.    FLDCW round_down
  51.    FLD ST(0)          {  z         z          -   }
  52.    FRNDINT            { int(z)     z          -   }
  53.    FLDCW control_ww
  54.    FXCH               {  z         i          -   }
  55.    FSUB ST, ST(1)     {  f         i          -   }
  56.    F2XM1              { 2^f-1      i          -   }
  57.    FLD1               {  1        2^f-1       i   }
  58.    FADDP ST(1), ST    { 2^f        i          -   }
  59.    FSCALE             { 2^f.2^i    i          -   }
  60.    FST ST(1)          { e^x       e^x         -   }
  61.    FLD1               {  1         z          z   }
  62.    FDIVRP ST(1), ST   { 1/z        z          -   }
  63.    FADDP ST(1), ST    { z+1/z      -          -   }
  64.    FLD one_half       { 0.5       z+1/z       -   }
  65.    FMULP ST(1), ST    { ch(x)      -          -   }
  66. end;
  67.  
  68. function fsh(x : float): float; assembler;
  69. (* retourne le sinus hyperbolique de l'argument *)
  70. { sh(x) = [exp(x) - exp(-x)] / 2
  71. methode : z = exp(x), ch(x) = 1/2 (z - 1/z)
  72.           z = 2^y, y = x.log2(e),
  73.           z = 2^f.2^i, f = frac(y), i = int(y)
  74. { 2^f is computed with F2XM1, 2^i with FSCALE }
  75. const round_down : word = $177F;
  76.       one_half : float = 0.5;
  77. var   control_ww : word;
  78. asm                   { ST(0)     ST(1)     ST(2) }
  79.    FLD X              {  x         -         -    }
  80.    FLDL2E             { log2(e)    x         -    }
  81.    FMULP ST(1), ST    { x.log2(e)  -         -    }
  82.    FSTCW control_ww
  83.    FLDCW round_down
  84.    FLD ST(0)          {  y         y          -   }
  85.    FRNDINT            { int(y)     y          -   }
  86.    FLDCW control_ww
  87.    FXCH               {  y         i          -   }
  88.    FSUB ST, ST(1)     {  f         i          -   }
  89.    F2XM1              { 2^f-1      i          -   }
  90.    FLD1               {  1        2^f-1       i   }
  91.    FADDP ST(1), ST    { 2^f        i          -   }
  92.    FSCALE             { 2^f.2^i    i          -   }
  93.    FST ST(1)          { e^x       e^x         -   }
  94.    FLD1               {  1         z          z   }
  95.    FDIVRP ST(1), ST   { 1/z        z          -   }
  96.    FSUBP ST(1), ST    { z-1/z      -          -   }
  97.    FLD one_half       { 0.5      z-1/z)       -   }
  98.    FMULP ST(1), ST    { sh(x)      -          -   }
  99. end;
  100.  
  101. function fth(x : float): float; assembler;
  102. (* retourne la tangente hyperbolique de l'argument *)
  103. (* th(x) = sh(x) / ch(x) *)
  104. { th(x) = [exp(x) - exp(x)] / [exp(x) + exp(-x)]
  105. methode : z = exp(x), ch(x) = (z - 1/z) / (z + 1/z)
  106.           z = 2^y, y = x.log2(e),
  107.           z = 2^f.2^i, f = frac(y), i = int(y)
  108. { 2^f is computed with F2XM1, 2^i with FSCALE }
  109. const round_down : word = $177F;
  110.       one_half : float = 0.5;
  111. var   control_ww : word;
  112. asm                   { ST(0)     ST(1)     ST(2) }
  113.    FLD X              {  x         -         -    }
  114.    FLDL2E             { log2(e)    x         -    }
  115.    FMULP ST(1), ST    { x.log2(e)  -         -    }
  116.    FSTCW control_ww
  117.    FLDCW round_down
  118.    FLD ST(0)          {  z         z          -   }
  119.    FRNDINT            { int(z)     z          -   }
  120.    FLDCW control_ww
  121.    FXCH               {  z         i          -   }
  122.    FSUB ST, ST(1)     {  f         i          -   }
  123.    F2XM1              { 2^f-1      i          -   }
  124.    FLD1               {  1        2^f-1       i   }
  125.    FADDP ST(1), ST    { 2^f        i          -   }
  126.    FSCALE             { 2^f.2^i    i          -   }
  127.    FST ST(1)          { e^x       e^x         -   }
  128.    FLD1               {  1         z          z   }
  129.    FDIV  ST, ST(1)    { 1/z        z          z   }
  130.    FSUB  ST(2), ST    { 1/z        z        z-1/z }
  131.    FADDP ST(1), ST    { z+1/z    z-1/z        -   }
  132.    FDIVP ST(1), ST    { th(x)      -          -   }
  133. end;
  134.  
  135. (* fonctions trigonometriques inverses *)
  136.  
  137. function farg_ch(x : float): float; assembler;
  138. (* retourne l'arc cosinus hyperbolique de l'argument *)
  139. (*                       ________          *)
  140. (* arg ch(x) = ln ( x + V x.x - 1 )  x >=1 *)
  141. asm                 {  ST(0)         ST(1)          ST(2)  }
  142.    FLDLN2           {  ln(2)          -              -     }
  143.    FLD X            {   x            ln(2)           -     }
  144.    FLD ST(0)        {   x             x             ln(2)  }
  145.    FMUL ST(0), ST   {   x.x           x             ln(2)  }
  146.    FLD1             {   1             x.x            x     }
  147.    FSUBP ST(1), ST  { x.x - 1         x             ln(2)  }
  148.    FSQRT            { sqrt(x2-1)      x             ln(2)  }
  149.    FADDP ST(1), ST  { x + z          ln(2)           -     }
  150.    FYL2X            { arg_ch(x)       -              -     }
  151. end;
  152.  
  153. function farg_sh(x : float): float; assembler;
  154. (* retourne l'arc sinus hyperbolique de l'argument *)
  155. (*                       _________   *)
  156. (* arg sh(x) = ln ( x + V x.x + 1 )  *)
  157. asm                 {  ST(0)         ST(1)          ST(2)  }
  158.    FLDLN2           {  ln(2)          -              -     }
  159.    FLD X            {   x            ln(2)           -     }
  160.    FLD ST(0)        {   x             x             ln(2)  }
  161.    FMUL ST(0), ST   {   x.x           x             ln(2)  }
  162.    FLD1             {   1             x.x            x     }
  163.    FADDP ST(1), ST  { x.x + 1         x             ln(2)  }
  164.    FSQRT            { sqrt(x.x+1)     x             ln(2)  }
  165.    FADDP ST(1), ST  { x + z          ln(2)           -     }
  166.    FYL2X            { arg_sh(x)       -              -     }
  167. end;
  168.  
  169. function farg_th(x : float): float; assembler;
  170. (* retourne l'arc tangente hyperbolique de l'argument *)
  171. (* arg th(x) = 1/2 ln [ (1 + x) / (1 - x) *)
  172. asm                 {  ST(0)         ST(1)          ST(2)  }
  173.    FLDLN2           {  ln(2)          -              -     }
  174.    FLD X            {   x            ln(2)           -     }
  175.    FLD ST(0)        {   x             x             ln(2)  }
  176.    FLD1             {   1             x              x     }
  177.    FADDP ST(1), ST  { 1 + x           x             ln(2)  }
  178.    FXCH             {   x            1 + x          ln(2)  }
  179.    FLD1             {   1             x             1 + x  }
  180.    FSUBRP ST(1), ST { 1 - x          1 + x          ln(2)  }
  181.    FDIVP ST(1), ST  { 1+x/1-x        ln(2)           -     }
  182.    FSQRT            {                ln(2)           -     }
  183.    FYL2X            { ln(z)           -              -     }
  184. end;
  185.  
  186. end.